home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0826.ZIP / LOCK4.ARC / LOCK4.PAS next >
Pascal/Delphi Source File  |  1987-11-16  |  5KB  |  159 lines
  1. {********************************************************************}
  2. {* Lock4 - DOS 3 Record Locking for Turbo Pascal 4.0                *}
  3. {* versin 1.0 11/16/87                                              *}
  4. {* by Richard Sadowsky 74017,1670                                   *}
  5. {* Released to the public domain                                    *}
  6. {********************************************************************}
  7. {$I-} { It is required to turn off abort on I/O error with $I- }
  8. Unit Lock4;
  9.  
  10. Interface
  11.  
  12. uses DOS;
  13.  
  14. var
  15.   DOS_Major,DOS_Minor : Word; { These words hold the DOS version   }
  16.                               { They are initialized automatically }
  17.                               { Whenever you include Lock4 in the  }
  18.                               { list of units your program Uses    }
  19.  
  20. function HiLong(Long : LongInt) : Word;
  21. { This inline directive is similar to Turbo's Hi() function, except }
  22. { it returns the high word of a LongInt                             }
  23. Inline(
  24.   $5A/       {pop      dx    ; low word of long}
  25.   $58);      {pop      ax    ; hi word of long}
  26.  
  27. function LowLong(Long : LongInt) : Word;
  28. { This inline directive is similar to Turbo's Lo() function, except }
  29. { it returns the Low word of a LongInt                              }
  30. Inline(
  31.   $5A/       {pop      dx    ; low word of long}
  32.   $58/       {pop      ax    ; hi word of long}
  33.   $89/$D0);  {mov      ax,dx ; return lo word as function result in Ax}
  34.  
  35. function GetHandle(var F : File) : Word;
  36.  
  37. function DosVer(var Minor : Word) : Word;
  38.  
  39. function LockFile(Handle : Word; FilePosition,FileLength : LongInt) : Word;
  40.  
  41. function UnLockFile(Handle : Word; FilePosition,FileLength : LongInt) : Word;
  42.  
  43. function RetryFile(Handle,Wait,Retry : Word) : Word;
  44.  
  45. implementation
  46.  
  47. function GetHandle(var F : File) : Word;
  48. { This function returns a file handle from any Turbo Pascal File type }
  49. var
  50.   Handle : Word absolute F;
  51.  
  52. begin
  53.   GetHandle := Handle;
  54. end;
  55.  
  56. function DosVer(var Minor : Word) : Word;
  57. { This function returns the DOS major version as it's result, and }
  58. { the minor version as a var parameter }
  59. var
  60.   Reg : Registers;
  61.  
  62. begin
  63.   with Reg do begin
  64.     Ax := $3000;
  65.     MsDos(Reg);
  66.     DosVer := Al;
  67.     Minor  := Ah;
  68.   end;
  69. end;
  70.  
  71. function LockFile(Handle : Word; FilePosition,FileLength : LongInt) : Word;
  72. { This function uses DOS call 5Ch to lock all or part of a file.  }
  73. { The DOS error code is returned as the result.  The file takes a }
  74. { word for the file handle, followed by two LongInts, representing}
  75. { the file position (or offset), and the size in bytes to lock    }
  76. { starting at said offset. Make sure you Unlock any locks before  }
  77. { closing the file.  An error code of 1 means invalid DOS version.}
  78. { It may also mean that SHARE hasn't been run .                   }
  79. { See DOS Technical Reference or (Duncan's Advanced MS-DOS) for   }
  80. { info on error codes. }
  81. var
  82.   Reg : Registers;
  83.   H,L,Minor : Word;
  84.  
  85. begin
  86.   if DOS_Major < 3 then begin
  87.     LockFile := 1;
  88.     Exit;
  89.   end;
  90.   with Reg do begin
  91.     Ax := $5C00; {DOS call 5Ch}
  92.     Bx := Handle;
  93.     Cx := HiLong(FilePosition);
  94.     Dx := LowLong(FilePosition);
  95.     Si := HiLong(FileLength);
  96.     Di := LowLong(FileLength);
  97.     MsDos(Reg);
  98.     if ((Flags and 1) <> 0) then
  99.       LockFile := Ax
  100.     else
  101.       LockFile := 0;
  102.   end;
  103. end;
  104.  
  105. function UnLockFile(Handle : Word; FilePosition,FileLength : LongInt) : Word;
  106. { Similar to LockFile, except uses DOS call 5Ch sunfunction 1  }
  107. { You must ensure that the offset and FileLength are identical }
  108. { to the ones used to lock the file                            }
  109. var
  110.   Reg : Registers;
  111.   H,L,Minor : Word;
  112.  
  113. begin
  114.   if DOS_Major < 3 then begin
  115.     UnLockFile := 1;
  116.     Exit;
  117.   end;
  118.   with Reg do begin
  119.     Ax := $5C01; {DOS call 5Ch, subfunction 1}
  120.     Bx := Handle;
  121.     Cx := HiLong(FilePosition);
  122.     Dx := LowLong(FilePosition);
  123.     Si := HiLong(FileLength);
  124.     Di := LowLong(FileLength);
  125.     MsDos(Reg);
  126.     if ((Flags and 1) <> 0) then
  127.       UnLockFile := Ax
  128.     else
  129.       UnLockFile := 0;
  130.   end;
  131. end;
  132.  
  133. function RetryFile(Handle,Wait,Retry : Word) : Word;
  134. { This function sets the number of times DOS will retry before returning }
  135. { an i/o error.  It also sets the time dalay between retries.            }
  136. var
  137.   Reg : Registers;
  138.  
  139. begin
  140.   if DOS_Major < 3 then begin
  141.     RetryFile := 1;
  142.     Exit;
  143.   end;
  144.   with Reg do begin
  145.     Ax := $440B;
  146.     Bx := Handle;
  147.     Cx := Wait;
  148.     Dx := Retry;
  149.     MsDos(Reg);
  150.     if ((Flags and 1) <> 0) then
  151.       RetryFile := Ax
  152.     else
  153.       RetryFile := 0;
  154.   end;
  155. end;
  156.  
  157. begin { initialization code }
  158.   DOS_Major := DosVer(DOS_Minor)
  159. end.